home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnu_tile_forth.lha / tst / task-sieve.tst < prev    next >
Text File  |  1992-05-19  |  2KB  |  52 lines
  1. .( Loading Multi-tasking Sieve benchmark...) cr
  2.  
  3. \ A fancy way of calculating prime numbers using dynamic creation of tasks.
  4. \ Adapted from Barnes, Programming in Ada, 3rd ed., Addison-Wesley, 1989
  5. \ ch. 14 Tasking, sec. 9 Examples of Task Types, pp. 324-327.
  6.  
  7. #include structures.f83
  8. #include multi-tasking.f83
  9.  
  10. structures multi-tasking forth definitions
  11.  
  12. ONE-TO-ONE CHAN parameter        ( Parameter passing channel)
  13.  
  14. 16 16 task.type FILTER ( -- )
  15.   ptr  previous                ( Channel to previous task)
  16.   long prime                ( The local prime number)
  17.   ptr  next                ( Channel to next task)
  18. task.body
  19.   parameter receive previous !        ( Receive previous task channel)
  20.   parameter receive dup . prime !    ( And local prime number parameters)
  21.   nil next !                ( Initiate next task channel to nil)
  22.   begin                    ( For ever and ever do)
  23.     previous @ receive dup        ( Retrieve the next number to check)
  24.     prime @ mod                ( Check if not divisible)
  25.     if next @ ?dup            ( Check if there exists a next channel)
  26.       if send                ( Send to next filter task)
  27.       else            
  28.     new-task FILTER drop        ( Create a new filter task)
  29.     ONE-TO-ONE new-struct CHAN dup
  30.     next !                ( Save reference to next channel)
  31.     parameter send            ( Send previous channel name)
  32.     parameter send            ( And the prime number)
  33.       then
  34.     else
  35.       drop                ( Drop if divisible)
  36.     then                ( And try again)
  37.   again
  38. task.end
  39.  
  40. : task-sieve ( -- )
  41.   new-task FILTER drop            ( Create the initial filter task)
  42.   ONE-TO-ONE new-struct CHAN        ( And its previous channel)
  43.   dup parameter send            ( Send the parameters to the task)
  44.   2 parameter send
  45.   1024 3 do                ( Send a stream of number and)
  46.     i over send                ( let the tasks filter out the)
  47.   loop                    ( prime numbers)
  48.   drop
  49. ;
  50.  
  51. forth only
  52.